      PROGRAM FLOPPY
C-------------------------------------------------------------------------
C Floppy UNIX interface routine.
C Sets up various required input files for Floppy.
C 
C Julian Bunn 1990
C-------------------------------------------------------------------------
      PARAMETER (MLEN=256,MXLIN=80,maxarg=100)
      character*(mxlin) argval
      character*1 key,char
      CHARACTER*(MLEN)  CFILE,COLD,CFORT,CTEMP,CBAD,CTREE
      LOGICAL LOG,fexist,fold,fqold,tidy,tree
c
c get all arguments
c
      numargs = iargc()
      if(numargs.gt.maxarg) then
         write(6,'(A)') ' Floppy --> Too many arguments '
         goto 900
      endif
c
c get target filename(s)
c
      call getarg(numargs,cfile)       
      lfile = index(cfile,' ')-1
      write(6,'(A)') ' Floppy --> Target file '//cfile(:lfile)
      inquire(file=cfile(:lfile),exist=fexist)
      if(.not.fexist) then
        write(6,'(A)') ' Floppy --> Target file not found !'
        goto 900
      endif
c
      log = .false.                          
      fold = .false.  
      tidy = .false.
      cfort = ' '
      ctree = ' '
      tree = .false.
c
      do 400 iarg=1,numargs-1
         call getarg(iarg,argval)
         if(argval(:2).eq.'-l') log = .true.
         if(argval(:2).eq.'-o') fqold = .true.
         if(argval(:2).eq.'-o') cold = argval(3:)
  400 continue
c
      cbad = 'scratch'
      open(7,status='scratch',err=999)
      WRITE(7,'(A)') 'LIST,GLOBAL,TYPE;'
      WRITE(7,'(A)') 'PRINT,ILLEGAL;'
      WRITE(7,'(A)') 'OPTIONS,USER;'
      if(fqold) then
        if(cold(1:1).eq.' ') cold = cfile(:lfile)//'.flopold'
        lold = index(cold,' ')-1
        inquire(file=cold(:lold),exist=fold)
        if(log) write(6,'(A)') ' Floppy --> Old file: '//cold(:lold)
        if(.not.fold) then
           write(6,'(A)') ' Floppy --> Old file not found !'
           goto 900
        endif
        cbad = cold
        open(15,file=cold,status='old',err=999)
  450   read(15,'(A)',end=451,err=999) ctemp      
        goto 450
  451   continue
      else
        cold = cfile(:lfile)//'.flopold'     
        lold = index(cold,' ')-1
        cbad = cold
        open(15,file=cold(:lold),status='unknown',err=999)
      endif
c
c loop over all qualifiers
c
      icheck = 0
      do 500 iarg = 1,numargs-1
         call getarg(iarg,argval)
         larg = index(argval,' ')-1 
         key = argval(2:2)
         if(key.eq.'l') then
           log = .true.
         else if(key.eq.'n') then
           if(argval(3:3).eq.' ') then
              write(6,'(A)') ' Floppy --> Missing value for -n'
              goto 900
           endif 
           cfort = argval(3:)
           lfort = index(cfort,' ')-1 
           if(log) write(6,'(A)') ' Floppy --> Tidied Fortran: '//
     &             cfort(:lfort) 
         else if(key.eq.'o') then
c
         else if(key.eq.'f') then
           if(log) write(6,'(A)') ' Floppy --> List source line numbers'
           write(15,'(a)') '*FULL'
         else if(key.eq.'i') then
           ctemp = argval(3:)
   50      iend = index(ctemp,',')
           if(iend.ne.0) then
             write(15,'(A)') ctemp(:iend-1)
             if(log) write(6,'(A)') 
     &         ' Floppy --> Ignore: '//ctemp(:iend-1) 
             ctemp = ctemp(iend+1:)
             goto 50
           endif
           iend = index(ctemp,' ')
           write(15,'(A)') ctemp(:iend)
           if(log) write(6,'(A)') ' Floppy --> Ignore: '//ctemp(:iend)
         else if(key.eq.'c') then
           icheck = 1
           ctemp = argval(3:)
           if(ctemp.eq.'standard') then
             write(15,'(A)') '*CHECK RULE *'
             if(log) write(6,'(A)') ' Floppy --> Check Standard rules'
           else if(ctemp.eq.' ') then
             write(15,'(A)') '*CHECK RULE *'
             if(log) write(6,'(A)') ' Floppy --> Check Standard rules'
           else if(ctemp.eq.'a') then
              write(15,'(A)') '*CHECK RULE 99'
              if(log) write(6,'(A)') ' Floppy --> Check all rules'
           else if(ctemp.eq.'n') then
             write(15,'(A)') '*CHECK RULE -99'
              if(log) write(6,'(A)') ' Floppy --> No rule checks'
           else 
             ctemp = ctemp(:index(ctemp,' ')-1)
             if(log) write(6,'(A)') ' Floppy --> Check rules: '//
     &               ctemp(:index(ctemp,' ')-1)
   51        iend = index(ctemp,',')
             if(iend.ne.0) then
               write(15,'(A)') '*CHECK RULE '//ctemp(:iend-1)
               ctemp = ctemp(iend+1:)
               goto 51
             endif
             write(15,'(A)') '*CHECK RULE '//ctemp
           endif 
         else if(key.eq.'t') then
           write(7,'(A)') 'OPTIONS,TREE;'
           ctree = cfile(:lfile)//'.floptre'
           ltree = index(ctree,' ')-1
           if(log) write(6,'(A)') 
     &             ' Floppy --> Produce file for Flow: '//ctree(:ltree)
           open(50,file=ctree(:ltree),status='new',
     &          form='unformatted',err=999)
           tree = .true.
         else if(key.eq.'j') then
           char = argval(3:3)
           if(char.eq.' ') char = '3'
           write(7,'(A)') 'OPTIONS,INDENT='//char//';'
           if(log) write(6,'(A)') ' Floppy --> Indent clauses by '//char
           tidy = .true.
         else if(key.eq.'f') then
           write(7,'(A)') 'STATEMENTS,SEPARATE;'
           if(log) write(6,'(A)') ' Floppy --> Group FORMATs at end'
           tidy = .true.
         else if(key.eq.'g') then
           write(7,'(A)') 'STATEMENTS,GOTO;'
           if(log) write(6,'(A)') ' Floppy --> Right align GOTOs'
           tidy = .true.
         else if(key.eq.'r') then
           ctemp = argval(3:)
           iend = index(ctemp,',')
           if (iend.eq.0) ctemp = ctemp(:index(ctemp,' ')-1)//',10'
           write(7,'(A)') 'STATEMENTS,FORMAT='//
     &                    ctemp(:index(ctemp,' ')-1)//';'
           if(log) write(6,'(A)') ' Floppy --> Renumber FORMATs: '//
     &             'start,step '//ctemp(:index(ctemp,' '))
           tidy = .true.
         else if(key.eq.'s') then
           ctemp = argval(3:)
           iend = index(ctemp,',')
           if (iend.eq.0) ctemp = ctemp(:index(ctemp,' ')-1)//',10'
           write(7,'(A)') 'STATEMENTS,NUMBER='//
     &                    ctemp(:index(ctemp,' ')-1)//';'
           if(log) write(6,'(A)') ' Floppy --> Renumber statements: '//
     &             'start,step '//ctemp(:index(ctemp,' '))
           tidy = .true.
         else 
           write(6,'(A)') ' Floppy --> Unrecognized qualifier '//key
         endif
  500 continue
c
      if(tidy) then
         write(7,'(A)') 'OUTPUT,FULL,COMPRESS;'
         if(cfort(1:1).eq.' ') then
           cfort = cfile(:lfile)//'.out'
           lfort = index(cfort,' ')-1
         endif
         cbad = cfort
         open(14,file=cfort(:lfort),status='unknown',err=999)
      endif 
c
c default action is to check standard rules
c
      if(icheck.eq.0.and..not.fqold) then
         write(15,'(A)') '*CHECK RULE *'
      endif
         
      write(7,'(A)') 'END;'
      if(log) write(6,'(A)') ' Floppy --> Finished parsing command' 
      rewind(7)
      rewind(15)
      cbad = cfile
      open(11,file=cfile(:lfile),status='old',err=999)
      cbad = 'scratch'
      open(99,status='scratch',err=999)
c
      call allpro
c
      close(11)
      if(tidy) close(14)
      if(tree) close(50)
      close(7)
      close(99)
      write(6,'(A)') ' Floppy --> has finished'
      goto 2000
C
  999 CONTINUE
      WRITE(6,'(A)') ' Floppy --> Error opening '//
     &               cbad(:index(cbad,' ')) 
  900 write(6,'(A)') ' Floppy aborted'     
 2000 CONTINUE
      END
